with Ada.Exceptions;
with Cairo.Surface.Image, Cairo.Font_Face.FT;
with FT2.Base, FT2.Types, Freetype2;
with Legend.Traces;
with Legend.Settings;
with Generic_Number_Image;
with CairoSDL;
-- with SDL_ttf;
with Ada.Environment_Variables;
package body Legend.Renders is

   procedure Accept_Brush_Changed (this : in out Canvas_Type)
   is
   begin
      CairoSDL.Flush(Cairo.Surface.Ref(this.Surface_Handle).Ptr);
   end Accept_Brush_Changed;

   procedure Accept_SDL_Changed (this : in out Canvas_Type)
   is
   begin
      CairoSDL.Mark_Dirty(Cairo.Surface.Ref(this.Surface_Handle).Ptr);
   end Accept_SDL_Changed;

   procedure Set_Brush_Color (
      this  : in out Canvas_Type;
      Color : Color_Type
      )
   is
      use Interfaces.C;
   begin
      this.As_Brush.Set_Source_RGBA(
         double(Color.R) / 255.0, 
         double(Color.G) / 255.0, 
         double(Color.B) / 255.0,
         double(Color.A) / 255.0);
   end Set_Brush_Color;


   procedure Draw_Round_Rect (
      this       : in out Canvas_Type;
      Region     : SDL.Video.Rect_t; 
      Back_Color : Color_Type := Colors.Black;
      Fore_Color : Color_Type := Colors.White;
      Width      : Interfaces.C.double := 2.0;
      Groove     : Boolean := True
      )
   is
      use Interfaces.C;
      brush : Cairo.Context.Cairo_Context_Ref := this.As_Brush;
   begin
      this.Set_Brush_Color(Fore_Color);
      brush.Set_Line_Width(Width);
      brush.Rectangle(
         double(Region.X),
         double(Region.Y),
         double(Region.W),
         double(Region.H));
      if Groove then
         declare
            p : double := 1.0 + Width;
            q : double := p * 2.0;
         begin
            brush.Rectangle(
               double(Region.X) + p, 
               double(Region.Y) + p,
               double(Region.X + Int16_t(Region.W)) - q, 
               double(Region.Y + Int16_t(Region.H)) - q);
         end;
      end if;
      brush.Stroke;
      this.Set_Brush_Color(Back_Color);
      brush.Fill;
   end Draw_Round_Rect;

   procedure Draw_Border (
      this   : in out Canvas_Type;
      Color  : Color_Type := Colors.White;
      Width  : Interfaces.C.double := 2.0;
      Groove : Boolean := True
      )
   is
      use Interfaces.C;
      brush : Cairo.Context.Cairo_Context_Ref := this.As_Brush;
      r : SDL.Video.Rect_t renames this.Region;
   begin
      this.Set_Brush_Color(Color);
      brush.Set_Line_Width(Width);
      brush.Rectangle(0.0, 0.0, double(r.W), double(r.H));
      if Groove then
         declare
            p : double := 1.0 + Width;
         begin
            brush.Rectangle(p, p, double(r.W) - p * 2.0, double(r.H) - p * 2.0);
         end;
      end if;
      brush.Stroke;
   end Draw_Border;

   procedure Check_SDL_Error(prompt : String)
   is
   begin
      Trace_Log(prompt & " : " & SDL.Error.Get_Error);
   end Check_SDL_Error;

   procedure Bind (
      this    : in out Canvas_Type;
      Region  : SDL.Video.Rect_t := Full_Canvas;
      Save_Region : Boolean := False
      )
   is
      use Interfaces.C;
      procedure Compute_Overlap_Region 
      is
         use type SDL.Video.Rect_t;
         full_screen : Boolean := Region = Full_Canvas;
         r : SDL.Video.Rect_t;
      begin
         -- compute overlap region
         r := Region;
         if full_screen then
            r.W := Uint16_t(screen.W);
            r.H := Uint16_t(screen.H);
         end if;
         -- check if overlap size has changed
         if this.Region /= r then
            this.Restore_Overlap_Surface;
            if this.Surface /= null then
               SDL.Video.Free_Surface(this.Surface);
            end if;
            this.Surface := Create_SDL_Surface(r.W, r.H);
            this.Region := r;
            if Save_Region then
               this.Save_Overlap_Surface;
            end if;
         end if;
      end Compute_Overlap_Region;
   begin
      Compute_Overlap_Region;
      this.Surface_Handle := Cairo.Surface.To_Handle(
         CairoSDL.New_Cairo_Surface(this.Surface),
         False);
      this.Context_Handle := Cairo.Context.New_Context(
         Target => Cairo.Surface.Ref(this.Surface_Handle));
      this.Version.Reset;
      this.Performance.Reset;
   end Bind;

   function As_Surface (
      this : Canvas_Type
      ) return SDL.Video.Surface_Access_t
   is
      pragma Inline(As_Surface);
   begin
      return this.Surface;
   end As_Surface;

   function As_Brush (
      this : Canvas_Type
      ) return Cairo.Context.Cairo_Context_Ref
   is
      pragma Inline(As_Brush);
   begin
      return Cairo.Context.Ref(this.Context_Handle);
   end As_Brush;

   function To_Cairo_Color (
      this : Canvas_Type;
      C    : Color_Type
      ) return Uint32_t
   is
   begin
      return SDL.Video.Map_RGBA(this.Surface.Format, C.R, C.G, C.B, C.A);
   end To_Cairo_Color;


   procedure Clear (
      this : in out Canvas_Type;
      Color : Color_Type := Colors.Black 
      )
   is
      C : Uint32_t := SDL.Video.Map_RGBA(
         this.Surface.Format, 
         Color.R, 
         Color.G, 
         Color.B, 
         Color.A);
   begin
      SDL.Video.Fill_Rect(this.Surface, null, this.To_Cairo_Color(Color));
      this.Accept_SDL_Changed;
   end Clear;

   procedure Invalidate (this : in out Canvas_Type)
   is
      pragma Inline(Invalidate);
   begin
      this.Version.Build;
   end Invalidate;

   function Get_Performance (
      this : Canvas_Type
      ) return Performances.Monitor_Pointer
   is
      pragma Inline(Get_Performance);
   begin
      return this.Performance'Unrestricted_Access;
   end Get_Performance;

   procedure Update_Screen (
      this : in out Canvas_Type
      )
   is
   begin
--      SDL.Video.Flip(Screen);
      SDL.Video.Update_Rect(
         Screen,
         Int32_t(this.Region.X), 
         Int32_t(this.Region.Y), 
         Int32_t(this.Region.W), 
         Int32_t(this.Region.H));
   end Update_Screen;

   procedure Show (
      this : in out Canvas_Type;
      Surface : SDL.Video.Surface_Access_t
      )
   is
   begin
      SDL.Video.Blit_Surface(Surface, null, Screen, this.Region);
   end Show;

   procedure Repaint (this : in out Canvas_Type'Class)
   is
   begin
      if this.Version.Has_Changed then
         this.Performance.Start;
         this.Painter.Paint;
         this.Version.Publish;
         this.Restore_Overlap_Surface;
         this.Show(this.Surface);
         this.Update_Screen;
         this.Performance.Stop;
      end if;
   end Repaint;

   procedure Initialize (this : in out Canvas_Type)
   is
   begin
      this.Region := Full_Canvas;
      this.Surface := null;
      this.Overlap := null;
   end Initialize;

   procedure Finalize (this : in out Canvas_Type)
   is
   begin
      if this.Surface /= null then
         SDL.Video.Free_Surface (this.Surface);
         this.Surface := null;
      end if;
      this.Restore_Overlap_Surface;
      if this.Overlap /= null then
         SDL.Video.Free_Surface(this.Overlap);
         this.Overlap := null;
      end if;
   end Finalize;

   procedure Set_True_Font (
      this   : in out Canvas_Type;
      Family : String := "Default"
      )
   is
      fn : String := Family & ".ttf";
      fh : Cairo.Font_Face.Cairo_Font_Face_Handle renames this.Font_Handle; 
      fr : Cairo.Font_Face.Cairo_Font_Face_Ref renames this.Font_Ref;
   begin
      if Ada.Environment_Variables.Exists("OS") then
         if Ada.Environment_Variables.Value("OS") = "Windows_NT" then
            this.As_Brush.Select_Font_Face(
               "simsun", 
               Cairo.CAIRO_FONT_SLANT_NORMAL, 
               Cairo.CAIRO_FONT_WEIGHT_NORMAL);
            return;
         end if;
      end if;
      fh := Cairo.Font_Face.FT.New_Font_Face(Freetype2.Get_Font(fn));
      fr := Cairo.Font_Face.Ref(fh);
      this.As_Brush.Set_Font_Face(fr);
   end Set_True_Font;

   -- FIXME
   -- unset_synthesize seems not work, why? 
   procedure Set_True_Font_Style (
      this   : in out Canvas_Type;
      Italic : Boolean := False;
      Bold   : Boolean := False
      )
   is
--      type Flag is mod 2 ** 2 with Size => Interfaces.C.unsigned'Size;
--      K_Bold   : constant Flag := 2 ** 0;
--      K_Italic : constant Flag := 2 ** 1;
--      Flags : Flag := (if Italic then K_Italic else 0) or 
--         (if Bold then K_Bold else 0);
--      procedure cairo_ft_font_face_set_synthesize (
--         font_face : Cairo.Font_Face_Ptr := this.Font_Ref.Ptr;
--         synth_flags : Flag := Flags
--         ) with Import, Convention => C;
--      procedure cairo_ft_font_face_unset_synthesize (
--         font_face : Cairo.Font_Face_Ptr := this.Font_Ref.Ptr;
--         synth_flags : Flag := K_Bold or K_Italic
--         ) with Import, Convention => C;
--      function cairo_ft_font_face_get_synthesize (
--         font_face : Cairo.Font_Face_Ptr := this.Font_Ref.Ptr
--         ) return Flag with Import, Convention => C;
   begin
      null;
--      cairo_ft_font_face_unset_synthesize;
--      if Bold or Italic then
--         cairo_ft_font_face_set_synthesize;
--      end if;
   end Set_True_Font_Style;

   function Create_SDL_Surface (
      Width, Height  : Uint16_t
      ) return SDL.Video.Surface_Access_t
   is
      t : SDL.Video.Surface_Access_t;
   begin
      -- create CAIRO_FORMAT_ARGB32 SDL_Surface
      t := SDL.Video.Create_RGB_Surface (
         Flags  => SDL.Video.SWSURFACE,
         Width  => Interfaces.C.int(Width),
         Height => Interfaces.C.int(Height),
         Bpp    => 32,
         Rmask  => 16#00_FF_00_00#,
         Gmask  => 16#00_00_FF_00#,
         Bmask  => 16#00_00_00_FF#,
         Amask  => 16#FF_00_00_00#);
      return t;
   end Create_SDL_Surface;

   procedure Save_Overlap_Surface (this : in out Canvas_Type'Class)
   is
      S : SDL.Video.Surface_Access_t := Screen;
   begin
      this.Overlap := SDL.Video.Create_RGB_Surface(
         Flags  => SDL.Video.SWSURFACE,
         Width  => Interfaces.C.int(this.Region.W),
         Height => Interfaces.C.int(this.Region.H),
         Bpp    => 32,
         Rmask  => S.Format.Rmask,
         Gmask  => S.Format.Gmask,
         Bmask  => S.Format.Bmask,
         Amask  => S.Format.Amask);
      SDL.Video.Blit_Surface(S, this.Region, this.Overlap, null);
--      Trace_Log("Save_Overlap_Surface");
   end Save_Overlap_Surface;

   procedure Restore_Overlap_Surface (this : in out Canvas_Type'Class)
   is
   begin
      if this.Overlap /= null then
         this.Show(this.Overlap);
--         this.Overlap := null;
--         Trace_Log("Restore_Overlap_Surface");
      end if;
   end Restore_Overlap_Surface;

   procedure Draw_Picture (
      this      : in out Canvas_Type;
      Picture   : Picture_Type;
      Position  : Point_Type
      )
   is
      p : Point_Type := Position - Picture.Position;
      r : SDL.Video.Rect_t := (X => p.X, Y => p.Y, others => <>);
   begin
      SDL.Video.Blit_Surface(Picture.Surface, null, this.Surface, r);
   end Draw_Picture;

--   procedure Draw_Text (
--      this : in out Canvas_Type;
--      Text : UTF8_String;
--      Where : Point_Type;
--      Color : Color_Type;
--      Family : String := "Default";
--      Size   : Natural := 16;
--      Flip  : Boolean := False
--      )
--   is
--      use SDL_ttf;
--      fp : Font_Ptr := Open_Font("./" & Family & ".ttf", Interfaces.C.int(Size));
--      sf : SDL.Video.Surface_Access_t;
--      r  : SDL.Video.Rect_t := (Where.x, Where.y, 0, 0);
--   begin
--      sf := Render_UTF8_Solid(fp, Text, Color);
--      SDL.Video.Blit_Surface(sf, null, this.As_Surface, r);
--      if Flip then
--         this.Accept_SDL_Changed;
--      end if;
--      SDL.Video.Free_Surface(sf);
--      CloseFont(fp);
--   end Draw_Text;

   procedure Draw_Canvas (
      this     : in out Canvas_Type;
      Source   : Canvas_Type'Class;
      Position : Point_Type
      )
   is
      p : Point_Type := Position;
      r : SDL.Video.Rect_t := (X => p.X, Y => p.Y, others => <>);
   begin
      SDL.Video.Blit_Surface(Source.Surface, null, this.Surface, r);
--      SDL.Video.Update_Rect(
--         this.Surface,
--         Int32_t(r.X), 
--         Int32_t(r.Y), 
--         Int32_t(Source.Surface.W), 
--         Int32_t(Source.Surface.H));
   end Draw_Canvas;

   procedure Draw_Movie (
      this     : in out Canvas_Type;
      Movie    : in out Movie_Type;
      Position : Point_Type
      )
   is
      picture_id : Uint16_t := Movie.First + Uint16_t(Movie.Index);
   begin
      this.Draw_Picture(Movie.Pictures(picture_id), Position);
--      Movie.Index := (Movie.Index + 1) mod Movie.Total;
   end Draw_Movie;

   function Make_Shadow (
      Color  : Color_Type;
      Width  : Uint16_t := 18; 
      Height : Uint16_t := 9
      )  return SDL.Video.Surface_Access_t 
   is
      use Interfaces.C;
      W : double := double(Width);
      H : double := double(Height);
      p : SDL.Video.Surface_Access_t := Create_SDL_Surface(Width, Height);
      sh : Cairo.Surface.Cairo_Surface_Handle := Cairo.Surface.To_Handle(
         CairoSDL.New_Cairo_Surface(p), 
         False);
      s : Cairo.Surface.Cairo_Surface_Ref := Cairo.Surface.Ref(sh);
      c : Cairo.Context.Cairo_Context_Handle := Cairo.Context.New_Context(s);
      b : Cairo.Context.Cairo_Context_Ref := Cairo.Context.Ref(c);
   begin
      b.Set_Source_RGBA(
         double(Color.R) / 255.0, 
         double(Color.G) / 255.0, 
         double(Color.B) / 255.0,
         double(Color.A) / 255.0);
      b.Set_Line_Width(1.0);
      b.Move_To(W / 2.0, 0.0);
      b.Line_To(W - 1.0, H / 2.0);
      b.Line_To(W / 2.0, H - 1.0);
      b.Line_To(0.0, H / 2.0);
      b.Line_To(W / 2.0, 0.0);
      b.Fill;
      b.Stroke;
      CairoSDL.Flush(s.Ptr);
      return p;
   end Make_Shadow;

   procedure Set_To_Opaque (Picture : in out Picture_Type)
   is
      dummy : Interfaces.C.int;
   begin
      dummy := SDL.Video.Set_Alpha(Picture.Surface, 0, 255);
   end Set_To_Opaque;

   function Display_Width (Text : UTF8_String) return Natural
   is
      n : Natural := UTF8_Length(Text);
      d : Natural := Text'Length - n;
      n_cn, n_en : Natural := 0;
   begin
      if d > 0 then
         n_cn := d / 2;
         n_en := n - n_cn;
         return n_cn + n_en / 2;
      else
         return n;
      end if;
   end Display_Width;

   procedure Toggle_Fullscreen
   is
      use type SDL.Video.Surface_Flags_t;
      flags : SDL.Video.Surface_Flags_t := Screen.Flags;
   begin
      if (flags and Video.Fullscreen) = Video.Fullscreen then
         flags := flags and not Video.Fullscreen;
      else
         flags := flags or Video.Fullscreen;
      end if;
      SDL.Video.Free_Surface(Screen);
      Screen := SDL.Video.Set_Video_Mode(
         Width  => Interfaces.C.int(Settings.Video.Screen_Width),
         Height => Interfaces.C.int(Settings.Video.Screen_Height),
         Bpp    => 32,
         Flags  => flags);
   end Toggle_Fullscreen;

   procedure Initialize
   is
      use type SDL.Video.Surface_Flags_t;
      flags : SDL.Video.Surface_Flags_t := Video.SWSURFACE;
      dummy : Interfaces.c.int;
      -- SWSURFACE is much fater than HWSURFACE
   begin
      if Settings.Video.Fullscreen then
         flags := flags or Video.Fullscreen;
      end if;
      Screen := SDL.Video.Set_Video_Mode(
         Width  => Interfaces.C.int(Settings.Video.Screen_Width),
         Height => Interfaces.C.int(Settings.Video.Screen_Height),
         Bpp    => 32,
         Flags  => flags);
      if Screen = null then
         raise SDL_Error with "SDL.Video.Set_Vidoe_Mode " & SDL.Error.Get_Error;
      end if;
--      Trace_Log(
--         "screen : {" &
--         "width : " & Settings.Video.Screen_Width'Img & ", " &
--         "height : " & Settings.Video.Screen_Height'Img & ", " & 
--         "Rmask : " & Traces.To_Hex(Screen.Format.RMask) & ", " &
--         "Gmask : " & Traces.To_Hex(Screen.Format.GMask) & ", " &
--         "Bmask : " & Traces.To_Hex(Screen.Format.BMask) & "}");
      Freetype2.Init;
--      dummy := SDL_ttf.Init;
   end Initialize;

   procedure Finalize
   is
   begin
--      SDL_ttf.TTF_Quit;
      Freetype2.Done;
      SDL.Video.Free_Surface(Screen);
   end Finalize;

end Legend.Renders;
